home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr50 / pb3brows.zip / BROWSE.BAS < prev    next >
BASIC Source File  |  1993-04-02  |  5KB  |  169 lines
  1. '******************************************************************************
  2. '*               PowerBasic 3 module for fileviewing                          *
  3. '*                      uses  BROWSASM.BAS en VID&KBD.BAS                     *
  4. '*                      (c) Hans Lunsing - 04/1993                            *
  5. '******************************************************************************
  6.  
  7. $DIM ARRAY
  8. $ERROR ALL -
  9. $LIB LPT -, COM -, GRAPH -, FULLFLOAT -, IPRINT -
  10. $OPTIMIZE SIZE
  11. $OPTION CNTLBREAK -, GOSUB -
  12. $STRING 1
  13.  
  14. DEFINT A-Z
  15.  
  16. $INCLUDE "GENERAL.BI"
  17.  
  18. ' Cachesize &H4000 (decimaal 16384) words, 32768 bytes
  19. ' N.B.: cachesize must be even !
  20. %CacheSize = &H4000
  21.  
  22. ' Assembler routines:
  23. DECLARE SUB InitBrowseFile (BYVAL WORD, BYVAL WORD, BYVAL WORD, BYVAL WORD)
  24. DECLARE SUB ShowFile (BYVAL INTEGER, BYVAL INTEGER, BYVAL INTEGER, _
  25.         BYVAL INTEGER, BYVAL INTEGER)
  26. DECLARE SUB LineDown ()
  27. DECLARE SUB LineUp ()
  28. DECLARE SUB PageDown (BYVAL INTEGER)
  29. DECLARE SUB PageUp (BYVAL INTEGER)
  30. DECLARE SUB EndFile (BYVAL INTEGER)
  31. DECLARE SUB HomeFile ()
  32. DECLARE SUB ExitBrowseFile ()
  33.  
  34. BrowseStatusRow:
  35. DATA "              │ Browse: Home End PgUp Pgdn  <->            Back: Enter or Esc "
  36.  
  37. SUB Browse (FileName$, BYVAL Top, BYVAL Bottom, BYVAL TextAttr, BYVAL Status, _
  38.     BYVAL StatusAttr, BYVAL Scroll, BYVAL WordStar, ErrCode) PUBLIC
  39.  
  40.   ' Functie: bekijk tekstbestand op scherm
  41.  
  42.   DIM FileNum AS INTEGER
  43.   DIM BeginOffset AS INTEGER  ' offset in bytes first line to use
  44.   DIM FirstText AS INTEGER    ' first text usable screenline
  45.   DIM LastText AS INTEGER     ' last  text usable screenline
  46.   DIM BeginColumn AS INTEGER  ' First textcolumn on the screen
  47.   DIM EndColumn AS INTEGER    ' First textcolummn NOT on screen
  48.   DIM TextRows AS INTEGER     ' Textlines on screen
  49.   DIM StatusRow AS INTEGER    ' Statusline
  50.   DIM StatusLine AS STRING    ' Cintents of the statusline
  51.   DIM SaveFg AS INTEGER       ' Current foregroundcolor
  52.   DIM SaveBg AS INTEGER       ' Current backgroundcolor
  53.   DIM FgT AS INTEGER, BgT AS INTEGER' Fore/background textcolor
  54.   DIM FgS AS INTEGER, BgS AS INTEGER' Fore/background statuslinecolor
  55.  
  56.   ErrCode = 0
  57.   ON LOCAL ERROR RESUME NEXT
  58.   IF pbvScrnMode <> 0 THEN
  59.      ErrCode = 250                            '  videomode not supported
  60.     EXIT SUB
  61.   END IF
  62.   FileNum = FREEFILE
  63.   OPEN FileName$ FOR INPUT AS #FileNum
  64.   ErrCode = ERRTEST
  65.   IF ErrCode > 0 THEN EXIT SUB
  66.   GOSUB GetBoundaries
  67.   IF LastText < FirstText THEN EXIT SUB
  68.   GOSUB GetParameters
  69.   ClearLines FirstText, LastText
  70.   IF StatusRow THEN
  71.     GOSUB PlaceStatusLine
  72.   END IF
  73.   DIM Cache(1 TO %CacheSize)          ' Cache for filecontents
  74.   BeginColumn = 0
  75.   TextRows = LastText - FirstText + 1
  76.   InitBrowseFile FILEATTR(FileNum, 2), VARSEG(Cache(1)), VARPTR(Cache(1)), _
  77.     %CacheSize
  78.   DO
  79.     ShowFile FirstText, TextRows, BeginColumn, TextAttr, Filter
  80.     SELECT CASE GetKey
  81.       CASE -81                'PgDn
  82.     PageDown TextRows
  83.       CASE -73                          'PgUp
  84.     PageUp TextRows
  85.         CASE -80                          'DownArrow
  86.     LineDown
  87.         CASE -72                          'Uparrow
  88.     LineUp
  89.       CASE -79                          'End
  90.     EndFile TextRows
  91.       CASE -71                          'Home
  92.     BeginColumn = 0
  93.     HomeFile
  94.         CASE 9, -77                       'Tab or RightArrow
  95.     BeginColumn = BeginColumn + Scroll
  96.         CASE -15, -75                     'Shift-Tab or LeftArrow
  97.     IF BeginColumn THEN
  98.       BeginColumn = BeginColumn - Scroll
  99.     END IF
  100.         CASE 13, 27                       'Enter or Escape
  101.     ExitBrowseFile
  102.     EXIT DO
  103.     END SELECT
  104.   LOOP
  105.   CLOSE #FileNum
  106.   EXIT SUB
  107.  
  108. GetBoundaries:
  109.   IF Top < 1 THEN
  110.     Top = 1
  111.   ELSEIF Top > pbvScrnRows THEN
  112.     Top = pbvScrnRows
  113.   END IF
  114.   IF Bottom < Top OR Bottom > pbvScrnRows THEN
  115.     Bottom = pbvScrnRows
  116.   END IF
  117.   StatusRow = 0
  118.   FirstText = Top
  119.   LastText = Bottom
  120.   SELECT CASE Status
  121.     CASE < 0
  122.       StatusRow = Bottom
  123.       LastText = Bottom - 1
  124.     CASE > 0
  125.       StatusRow = Top
  126.       FirstText = Top + 1
  127.   END SELECT
  128.   RETURN
  129.  
  130. GetParameters:
  131.   IF WordStar THEN
  132.     Filter = &H7F
  133.   ELSE
  134.     Filter = &HFF
  135.   END IF
  136.   IF TextAttr = 0 THEN
  137.     LOCATE FirstText, 1
  138.     TextAttr = GetActiveColor
  139.   END IF
  140.   IF Scroll = 0 THEN
  141.     Scroll = 8
  142.   END IF
  143.   RETURN
  144.  
  145. PlaceStatusLine:
  146.   ' Plaats statusregel
  147.   RESTORE BrowseStatusRow
  148.   READ StatusLine$
  149.   FOR i = LEN(FileName$) TO 1 STEP -1
  150.     IF INSTR("\:", MID$(FileName$, i, 1)) THEN EXIT FOR
  151.   NEXT i
  152.   MID$(StatusLine$, 2) = MID$(FileName$, i + 1)
  153.   IF StatusAttr THEN
  154.     FgS = StatusAttr AND &HF
  155.     BgS = StatusAttr \ &H10
  156.   ELSE
  157.     FgT = TextAttr AND &HF
  158.     BgT = TextAttr \ &H10
  159.     InvertColor FgT, BgT, FgS, BgS
  160.   END IF
  161.   GetAttr SaveFg, SaveBg
  162.   Attr FgS, BgS
  163.   LOCATE StatusRow, 1, 0
  164.   PRINT StatusLine$;
  165.   Attr SaveFg, SaveBg
  166.   RETURN
  167. END SUB
  168.  
  169.